home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / MIDICOM2.ZIP / DELPHMCB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-01  |  3.9 KB  |  140 lines
  1. { $Header:   G:/delphi/midi/vcs/delphmcb.pas   1.15   30 Apr 1996 19:03:46   DAVEC  $ }
  2.  
  3. {MIDI callback DLL for Delphi}
  4.  
  5. unit Delphmcb;
  6.  
  7. {$C PRELOAD FIXED PERMANENT}
  8.  
  9. interface
  10.  
  11. uses WinProcs, WinTypes, MMsystem, Circbuf, MidiDefs, MidiCons;
  12.  
  13. {$IFDEF WIN32}
  14. procedure midiHandler(
  15.           hMidiIn: HMidiIn;
  16.           wMsg: UINT;
  17.           dwInstance: DWORD;
  18.           dwParam1: DWORD;
  19.           dwParam2: DWORD); stdcall export;
  20. function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export;          
  21. {$ELSE}
  22. procedure midiHandler(
  23.           hMidiIn: HMidiIn;
  24.           wMsg: Word;
  25.           dwInstance: DWORD;
  26.           dwParam1: DWORD;
  27.           dwParam2: DWORD); export;
  28. function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; export;
  29. {$ENDIF}
  30.  
  31. implementation
  32.  
  33. { Add an event to the circular input buffer. }
  34. function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean;
  35. begin
  36.     If (PBuffer^.EventCount < PBuffer^.Capacity) Then
  37.         begin
  38.         Inc(Pbuffer^.EventCount);
  39.  
  40.         { Todo: better way of copying this record }
  41.         with PBuffer^.PNextput^ do
  42.             begin
  43.             Timestamp := PTheEvent^.Timestamp;
  44.             Data := PTheEvent^.Data;
  45.             Sysex := PTheEvent^.Sysex;
  46.           end;
  47.  
  48.         { Move to next put location, with wrap }
  49.         Inc(Pbuffer^.PNextPut);
  50.         If (PBuffer^.PNextPut = PBuffer^.PEnd) then
  51.             PBuffer^.PNextPut := PBuffer^.PStart;
  52.  
  53.         CircbufPutEvent := True;
  54.         end
  55.     else
  56.         CircbufPutEvent := False;
  57. end;
  58.  
  59. { This is the callback function specified when the MIDI device was opened
  60.   by midiInOpen. It's called at interrupt time when MIDI input is seen
  61.   by the MIDI device driver(s). See the docs for midiInOpen for restrictions
  62.   on the Windows functions that can be called in this interrupt. }
  63. procedure midiHandler(
  64.           hMidiIn: HMidiIn;
  65.           wMsg: UINT;
  66.           dwInstance: DWORD;
  67.           dwParam1: DWORD;
  68.           dwParam2: DWORD);
  69.  
  70. var
  71.     thisEvent: TMidiBufferItem;
  72.     thisCtlInfo: PMidiCtlInfo;
  73.     thisBuffer: PCircularBuffer;
  74.  
  75. Begin
  76.     case wMsg of
  77.  
  78.         mim_Open: {nothing};
  79.  
  80.         mim_Error: {TODO: handle (message to trigger exception?) };
  81.  
  82.         mim_Data, mim_Longdata, mim_Longerror:
  83.             { Note: mim_Longerror included because there's a bug in the Maui
  84.             input driver that sends MIM_LONGERROR for subsequent buffers when
  85.             the input buffer is smaller than the sysex block being received }
  86.  
  87.             begin
  88.             { TODO: Make filtered messages customisable, I'm sure someone wants to
  89.             do something with MTC! }
  90.             if (dwParam1 <> MIDI_ACTIVESENSING) and
  91.                             (dwParam1 <> MIDI_TIMINGCLOCK) then
  92.                 begin
  93.  
  94.                 { The device driver passes us the instance data pointer we
  95.                 specified for midiInOpen. Use this to get the buffer address
  96.                 and window handle for the MIDI control }
  97.                 thisCtlInfo := PMidiCtlInfo(dwInstance);
  98.                 thisBuffer := thisCtlInfo^.PBuffer;
  99.  
  100.                 { Screen out short messages if we've been asked to }
  101.                 if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
  102.                     and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
  103.                     begin
  104.                     with thisEvent do
  105.                         begin
  106.                         timestamp := dwParam2;
  107.                         if (wMsg = mim_Longdata) or
  108.                             (wMsg = mim_Longerror) then
  109.                             begin
  110.                             data := 0;
  111.                             sysex := PMidiHdr(dwParam1);
  112.                             end
  113.                         else
  114.                             begin
  115.                             data := dwParam1;
  116.                             sysex := Nil;
  117.                             end;
  118.                         end;
  119.                     if CircbufPutEvent( thisBuffer, @thisEvent ) then
  120.                         { Send a message to the control to say input's arrived }
  121.                         PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
  122.                     else
  123.                         { Buffer overflow }
  124.                         PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
  125.                     end;
  126.                 end;
  127.             end;
  128.  
  129.         mom_Done:    { Sysex output complete, dwParam1 is pointer to MIDIHDR }
  130.             begin
  131.             { Notify the control that its sysex output is finished.
  132.               The control should call midiOutUnprepareHeader before freeing the buffer }
  133.             PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
  134.             end;
  135.  
  136.     end;    { Case }
  137. end;
  138.  
  139. end.
  140.